home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 109 / EnigmaAmiga109CD.iso / dalla rivista / amiga.free / sorgenti vari / wolfedit2 2.0.4 source.sit / WolfEdit2 2.0.4 Source / UPixMapView.p < prev    next >
Text File  |  1996-03-26  |  4KB  |  190 lines
  1. unit UPixMapView;
  2.  
  3. interface
  4.     uses
  5.         QDOffscreen, UView, UScrap;
  6.  
  7.     type
  8.  
  9.         TPixMapView = object(TView)
  10.                 fGWorld: GWorldPtr;
  11.                 fPixMap: PixMapHandle;
  12.                 fNonEmpty: boolean;
  13.                 fChanged: boolean;
  14.                 procedure IPixMapView (itsWidth, itsHeight: integer; itsCTab: CTabHandle);
  15.                 procedure IPixMapViewX (itsExtent, itsBounds: Rect; itsCTab: CTabHandle);
  16.                 procedure Free;
  17.                 override;
  18.                 procedure ClearGWorld;
  19.                 procedure WithGWorld (procedure DoIt);
  20.                 procedure Draw;
  21.                 override;
  22.                 procedure SetupMenus;
  23.                 override;
  24.                 procedure DoMenuCommand (cmdNumber: integer);
  25.                 override;
  26.                 procedure DoCopy;
  27.                 procedure DoPaste;
  28.                 procedure DoClear;
  29.             end;
  30.  
  31. implementation
  32. {$IFC FALSE}
  33.     uses
  34.         UAnalysePict;
  35. {$ENDC}
  36.  
  37.     procedure ClearPort;
  38.     begin
  39.         EraseRect(thePort^.portRect);
  40.     end;
  41.  
  42.     procedure TPixMapView.IPixMapView (itsWidth, itsHeight: integer; itsCTab: CTabHandle);
  43.         var
  44.             r: Rect;
  45.     begin
  46.         SetRect(r, 0, 0, itsWidth, itsHeight);
  47.         IPixMapViewX(r, r, itsCTab);
  48.     end;
  49.  
  50.     procedure TPixMapView.IPixMapViewX (itsExtent, itsBounds: Rect; itsCTab: CTabHandle);
  51.         var
  52.             result: OSErr;
  53.             b: boolean;
  54.             gWorld: GWorldPtr;
  55.             width: integer;
  56.     begin
  57.         IView(nil, nil, itsExtent);
  58.         result := NewGWorld(gWorld, 8, itsBounds, itsCTab, nil, []);
  59.         fGWorld := gWorld;
  60.         fPixMap := GetGWorldPixMap(fGWorld);
  61.     {--- Make sure rowBytes = width ---}
  62.         width := itsBounds.right - itsBounds.left;
  63.         with fPixMap^^ do
  64.             rowBytes := BOR(BAND(rowBytes, $C000), width);
  65.         b := LockPixels(fPixMap);
  66.         ClearGWorld;
  67.         fNonEmpty := false;
  68.         fChanged := false;
  69.     end;
  70.  
  71.     procedure TPixMapView.Free;
  72.     begin
  73.         DisposeGWorld(fGWorld);
  74.         inherited Free;
  75.     end;
  76.  
  77.     procedure TPixMapView.ClearGWorld;
  78.     begin
  79.         WithGWorld(ClearPort);
  80.     end;
  81.  
  82.     procedure TPixMapView.WithGWorld (procedure DoIt);
  83.         var
  84.             oldPort: CGrafPtr;
  85.             oldDevice: GDHandle;
  86.     begin
  87.         GetGWorld(oldPort, oldDevice);
  88.         SetGWorld(fGWorld, nil);
  89.         DoIt;
  90.         SetGWorld(oldPort, oldDevice);
  91.     end;
  92.  
  93.     procedure TPixMapView.Draw;
  94.         var
  95.             r: Rect;
  96.     begin
  97.         EraseRect(fExtent);
  98.         r := fGWorld^.portRect;
  99.         CopyBits(BitMapPtr(fPixMap^)^, thePort^.portBits, r, r, srcCopy, nil);
  100.     end;
  101.  
  102.     procedure TPixMapView.SetupMenus;
  103.     begin
  104.         if fNonEmpty then begin
  105.                 EnableCmd(cutCmd);
  106.                 EnableCmd(copyCmd);
  107.                 EnableCmd(clearCmd);
  108.             end;
  109.         if ProbeScrap('PICT') then
  110.             EnableCmd(pasteCmd);
  111.         inherited SetupMenus;
  112.     end;
  113.  
  114.     procedure TPixMapView.DoMenuCommand (cmdNumber: integer);
  115.     begin
  116.         case cmdNumber of
  117.             cutCmd:  begin
  118.                     DoCopy;
  119.                     DoClear;
  120.                 end;
  121.             copyCmd: 
  122.                 DoCopy;
  123.             pasteCmd: 
  124.                 DoPaste;
  125.             clearCmd: 
  126.                 DoClear;
  127.             otherwise
  128.                 inherited DoMenuCommand(cmdNumber);
  129.         end;
  130.     end;
  131.  
  132.     procedure TPixMapView.DoCopy;
  133.         var
  134.             pict: PicHandle;
  135.  
  136.         procedure MakeAPict;
  137.             var
  138.                 r: Rect;
  139.         begin
  140.             r := fExtent;
  141.             pict := OpenPicture(r);
  142.             Draw;
  143.             ClosePicture;
  144.         end;
  145.  
  146.     begin {TPixMapView.DoCopy}
  147.         WithGWorld(MakeAPict);
  148. {ShowPicture(pict);}
  149.         ClearScrap;
  150.         WriteScrap('PICT', pict);
  151.         KillPicture(pict);
  152.     end;
  153.  
  154.     procedure TPixMapView.DoPaste;
  155.         var
  156.             pict: PicHandle;
  157.             r: Rect;
  158.  
  159.         procedure DrawThePict;
  160.         begin
  161.             EraseRect(thePort^.portRect);
  162.             DrawPicture(pict, thePort^.portRect);
  163.         end;
  164.  
  165.     begin {TPixMapView.DoPaste}
  166.         ReadScrap('PICT', pict);
  167.         if pict <> nil then begin
  168.                 WithGWorld(DrawThePict);
  169.                 Invalidate;
  170.                 KillPicture(pict);
  171.                 fNonEmpty := true;
  172.                 fChanged := true;
  173.                 if fDocument <> nil then
  174.                     fDocument.Changed;
  175.             end;
  176.     end;
  177.  
  178.     procedure TPixMapView.DoClear;
  179.     begin
  180.         if fNonEmpty then begin
  181.                 ClearGWorld;
  182.                 Invalidate;
  183.                 fNonEmpty := false;
  184.                 fChanged := true;
  185.                 if fDocument <> nil then
  186.                     fDocument.Changed;
  187.             end;
  188.     end;
  189.  
  190. end.